home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 July / EnigmA AMIGA RUN 20 (1997)(G.R. Edizioni)(IT)[!][issue 1997-07 & 08][EAR-CD IV].iso / earcd / dev / amos / moreusel.lha / AnimHalve.AMOS / AnimHalve.amosSourceCode
AMOS Source Code  |  1997-04-15  |  2KB  |  90 lines
  1. ' ***********************************
  2. ' *                                 *
  3. ' *       Animation Halve V1.0      *
  4. ' *     Written by Chris Hodges.    *
  5. ' *                                 *
  6. ' ***********************************
  7. '
  8. Gosub INIT
  9. Gosub MAKEANIM
  10. End 
  11. INIT:
  12.   Screen Open 1,640,80,2,$8000
  13.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  14.   S$=Fsel$("","","Selektieren Sie das","000-Bild der Animation")
  15.   If S$="" Then End 
  16.   S$=S$-"000"
  17.   T$=Fsel$("","","Geben Sie nun den neuen","Namen der Animation ein")
  18.   If T$="" Then End 
  19. Return 
  20. MAKEANIM:
  21.   A=0
  22.   Do 
  23.     A$=""
  24.     If A<100 Then A$=A$+"0"
  25.     If A<10 Then A$=A$+"0"
  26.     A$=A$+Mid$(Str$(A),2)
  27.     Exit If Exist(S$+A$)=0
  28.     Load Iff S$+A$,0
  29.     WX=Screen Width : WY=Screen Height : AC=Screen Colour
  30.     If AC<4096
  31.       Screen Open 1,WX/2,WY/2,AC,0
  32.       Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  33.       Get Palette 0
  34.       Screen Display 1,288-WX/4,168-WY/4,WX/2,WY/2
  35.       Zoom 0,0,0,WX,WY To 1,0,0,WX/2,WY/2
  36.       Save Iff T$+A$
  37.       Screen Close 1
  38.     Else 
  39.       For Y=0 To WY-1 Step 2
  40.         P=Colour(0) : MC0=P/$100 : MC1=(P and $F0)/16 : MC2=P mod 16
  41.         OC0=MC0 : OC1=MC1 : OC2=MC2
  42.         V0=0 : V1=0 : V2=0
  43.         For X=0 To WX-1
  44.           C=Point(X,Y) : Gosub SHAM
  45.           If(X and 1)=0
  46.             Gosub HAM
  47.             Plot X/2,Y/2,C
  48.           End If 
  49.         Next 
  50.       Next 
  51.       Screen Open 1,WX/2,WY/2,4096,0
  52.       Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  53.       Get Palette 0
  54.       Screen Display 1,288-WX/4,168-WY/4,WX/2,WY/2
  55.       Screen Copy 0 To 1
  56.       Save Iff T$+A$
  57.     End If 
  58.     Inc A
  59.   Loop 
  60. Return 
  61. SHAM:
  62.   If C<16 Then P=Colour(C) : MC0=P/$100 : MC1=(P and $F0)/16 : MC2=P mod 16 : Return 
  63.   If C<32 Then MC2=C-16 : Return 
  64.   If C<48 Then MC0=C-32 : Return 
  65.   MC1=C-48
  66. Return 
  67. HAM:
  68.   For C=0 To 15
  69.     If MC0*$100+MC1*16+MC2=Colour(C) Then Exit 
  70.   Next 
  71.   If C=16
  72.     Gosub ALGO
  73.   Else 
  74.     V0=0 : V1=0 : V2=0
  75.     P=Colour(C) : MC0=P/$100 : MC1=(P and $F0)/16 : MC2=P mod 16
  76.     OC0=MC0 : OC1=MC1 : OC2=MC2
  77.   End If 
  78. Return 
  79. ALGO:
  80.   C=-1 : Gosub ALGO1
  81.   If C=-1 Then V0=0 : V1=0 : V2=0 : Gosub ALGO1
  82. Return 
  83. ALGO1:
  84.   D0=Abs(OC0-MC0)-V0*8
  85.   D1=Abs(OC1-MC1)-V1*8
  86.   D2=Abs(OC2-MC2)-V2*8
  87.   If D0=>D1 and D0=>D2 Then C=32+MC0 : OC0=MC0 : Inc V0 : V1=0 : V2=0 : Return 
  88.   If D1=>D0 and D1=>D2 Then C=48+MC1 : OC1=MC1 : Inc V1 : V0=0 : V2=0 : Return 
  89.   If D2=>D0 and D2=>D1 Then C=16+MC2 : OC2=MC2 : Inc V2 : V0=0 : V1=0 : Return 
  90. Return